home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / PAS_0793 / ARC-LOOK.PAS < prev    next >
Pascal/Delphi Source File  |  1993-08-01  |  11KB  |  311 lines
  1. (* Note from Steve Wierenga: Part of these messages were cut off somewhere.
  2. This should give you the basic structures, though. *)
  3.  
  4. {─ Fido Pascal Conference ────────────────────────────────────────────── PASCAL ─
  5. Msg  : 293 of 317
  6. From : MIKE COPELAND                       1:114/151.0          15 Jul 93  21:17
  7. To   : STEVEN SHEELEY
  8. Subj : ARCHIVE TPU 1/2
  9. ────────────────────────────────────────────────────────────────────────────────
  10.  SS> Does anyone have a TPU or know where I can get one that will
  11.  SS> handle the viewing and unarchiving of the popular archivers?
  12.  SS> (IE, ARJ, ZIP, LHA, PAK, Etc).
  13.  
  14.    This and the next message should help you...}
  15. Uses Dos;
  16. const
  17.       BSize    = 4096;                                      { I/O Buffer Size }
  18.       HMax     = 512;                                   { Header Maximum Size }
  19. var
  20.       I,J,K        : integer;
  21.       CT,RC,TC     : integer;
  22.       RES          : Word;                                   { Buffer Residue }
  23.       N,P,Q        : Longint;
  24.       C            : LongInt;                                 { Buffer Offset }
  25.       FSize        : LongInt;                                     { File Size }
  26.       DEVICE       : char;                                      { Disk Device }
  27.       F            : File;
  28.       SNAME        : String;
  29.       DATE         : string[8];                  { formatted date as YY/MM/DD }
  30.       TIME         : string[5];                  {     "     time as HH:MM    }
  31.       DirInfo      : SearchRec;                       { File name search type }
  32.       SR           : SearchRec;                       { File name search type }
  33.       DT           : DateTime;
  34.       PATH         : PathStr;
  35.       DIR          : DirStr;
  36.       FNAME        : NameStr;
  37.       EXT          : ExtStr;
  38.       Regs         : Registers;
  39.       BUFF         : array[1..BSize] of Byte;
  40.  
  41. procedure FDT (LI : LongInt);                       { Format Date/Time fields }
  42. begin
  43.   UnPackTime (LI,DT);
  44.   DATE := FSI(DT.Month,2)+'/'+FSI(DT.Day,2)+'/'+Copy(FSI(DT.Year,4),3,2);
  45.   if DATE[4] = ' ' then DATE[4] := '0';
  46.   if DATE[7] = ' ' then DATE[7] := '0';
  47.   TIME := FSI(DT.Hour,2)+':'+FSI(DT.Min,2);
  48.   if TIME[4] = ' ' then TIME[4] := '0';
  49. end;  { FDT }
  50.  
  51. procedure  MY_FFF;
  52. Var I,J,K : LongInt;
  53.  
  54. (**************************** ARJ Files Processing ***************************)
  55. Type ARJHead = record
  56.                  FHeadSize : Byte;
  57.                  ArcVer1,
  58.                  ArcVer2   : Byte;
  59.                  HostOS,
  60.                  ARJFlags,
  61.                  Method    : Byte;   { MethodType = (Stored, LZMost, LZFast); }
  62.                  R1,R2     : Byte;
  63.                  DOS_DT    : LongInt;
  64.                  CompSize,
  65.                  UCompSize,
  66.                  CRC       : LongInt;
  67.                  ENP, FM,
  68.                  HostData  : Word;
  69.                end;
  70. Var ARJ1     : ARJHead;
  71.     ARJId    : Word;                                     { 60000, if ARJ file }
  72.     HSize    : Word;                                            { Header Size }
  73. procedure GET_ARJ_ENTRY;
  74. begin
  75.   FillChar(ARJ1,SizeOf(ARJHead),#0); FillChar(BUFF,BSize,#0);
  76.   Seek (F,C-1); BlockRead(F,BUFF,BSIZE,RES);        { read header into buffer }
  77.   Move (BUFF[1],ARJId,2);  Move (BUFF[3],HSize,2);
  78.   if HSize > 0 then
  79.     with ARJ1 do
  80.       begin
  81.         Move (BUFF[5],ARJ1,SizeOf(ARJHead));
  82.         I := FHeadSize+5; SNAME := B40;
  83.         while BUFF[I] > 0 do Inc (I);
  84.         I := I-FHeadSize-5;
  85.         Move (BUFF[FHeadSize+5],SNAME[1],I); SNAME[0] := Chr(I);
  86.         FSize := CompSize; Inc (C,HSIZE);
  87.       end;
  88. end;  { GET_ARJ_ENTRY }
  89.  
  90. procedure DO_ARJ (FN : string);
  91. begin
  92.   Assign (F,FN); Reset (F,1); C := 1;
  93.   GET_ARJ_ENTRY;                                            { Process file
  94. Header }
  95.   repeat
  96.     Inc(C,FSize+10);
  97.     GET_ARJ_ENTRY;
  98.     if HSize > 0 then
  99.       begin
  100.         Inc (WPX); New(SW[WPX]);       { store filename info in dynamic array }
  101.         with SW[WPX]^ do
  102.           begin
  103.             FSplit (SNAME,DIR,FNAME,EXT); F := FNAME; E := Copy(EXT+'    ',1,4)
  104.             SIZE := ARJ1.UCompSize;
  105.             RTYPE := 4; D_T := ARJ1.DOS_DT; ANUM := ADX; VNUM := VDX;
  106.             ADD_CNAME;
  107.           end;
  108.         Inc (CCT); SSL; Inc (ARCS[ADX]^.COUNT)
  109.       end;
  110.   until HSize <= 0;
  111.   Close (F);
  112. end;  { DO_ARJ }
  113.  
  114. (**************************** ZIP Files Processing ***************************)
  115. Type ZIPHead = record
  116.                  ExtVer : Word;
  117.                  Flags  : Word;
  118.                  Method : Word;
  119.                  Fill1  : Word;
  120.                  DOS_DT        : LongInt;
  121.                  CRC32         : LongInt;
  122.                  CompSize      : LongInt;
  123.                  UCompSize     : LongInt;
  124.                  FileNameLen   : Word;
  125.                  ExtraFieldLen : Word;
  126.                end;
  127. Var ZIPCSize : LongInt;
  128.     ZIPId    : Word;
  129.     ZIP1     : ZIPHead;
  130. procedure GET_ZIP_ENTRY;
  131. begin
  132.   FillChar(ZIP1,SizeOf(ZIPHead),#0); Move (BUFF[C+1],ZIPId,2);
  133.   if ZIPId > 0 then
  134.     begin
  135.       Move (BUFF[C+1],ZIP1,SizeOf(ZIPHead));
  136.       Inc (C,43); SNAME := '';
  137.       with ZIP1 do
  138.         begin
  139.           Move (BUFF[C],SNAME[1],FileNameLen); SNAME[0] := Chr(FileNameLen);
  140.           FSize := CompSize;
  141.         end;
  142.     end;
  143. end;  { GET_ZIP_ENTRY }
  144.  
  145. procedure DO_ZIP (FN : string);
  146. const CFHS : string[4] = 'PK'#01#02;          { CENTRAL_FILE_HEADER_SIGNATURE }
  147.       ECDS : string[4] = 'PK'#05#06;        { END_CENTRAL_DIRECTORY_SIGNATURE }
  148. var S4     : string[4];
  149.     FOUND  : boolean;
  150.     QUIT   : boolean;                            { "end" sentinel encountered }
  151. begin
  152.   Assign (F,FN); Reset (F,1); C := 1; HSize := 0;
  153.   FSize := FileSize(F);
  154.   I := FSize-BSize;        { compute point to start read of central directory }
  155.   Seek (F,I); BlockRead (F,BUFF,BSize,RES);      { read ZIP central directory
  156. }
  157.   S4[0] := #4; C := 2;
  158.   repeat
  159.     FOUND := false; QUIT := false; { search for CENTRAL_FILE_HEADER_SIGNATURE }
  160.     while (not QUIT) and (not FOUND) do                 { modified B-M search }
  161.       begin
  162.  
  163. (**************************** ARC Files Processing ***************************)
  164. Type ARCHead = record
  165.                  ARCMark   : char;
  166.                  ARCVer    : Byte;
  167.                  FN        : array[1..13] of char;
  168.                  CompSize  : LongInt;
  169.                  DOS_DT    : LongInt;
  170.                  CRC       : Word;
  171.                  UCompSize : LongInt;
  172.                end;
  173. const ARCFlag : char = #26;                                        { ARC mark }
  174. Var WLV   : LongInt;                               { Working LongInt Variable }
  175.     ARC1  : ARCHead;
  176.     QUIT  : boolean;                             { "end" sentinel encountered }
  177.  
  178. procedure GET_ARC_ENTRY;
  179. begin
  180.   FillChar(ARC1,SizeOf(ARCHead),#0); L := SizeOf(ARCHead);
  181.   Seek (F,C); BlockRead (F,BUFF,L,RES);
  182.   Move (BUFF[1],ARC1,L);
  183.   with ARC1 do
  184.     if (ARCMark = ARCFlag) and (ARCVer > 0) then
  185.       begin
  186.         SNAME := ''; I := 1;
  187.         while FN[I] <> #0 do
  188.           begin
  189.             SNAME := SNAME+FN[I]; Inc(I)
  190.           end;
  191.         WLV := (DOS_DT Shr 16)+(DOS_DT Shl 16);              { flip Date/Time }
  192.         FSize := CompSize;
  193.       end;
  194.     QUIT := ARC1.ARCVer <= 0;
  195. end;  { GET_ARC_ENTRY }
  196.  
  197. procedure DO_ARC (FN : string);
  198. begin
  199.   Assign (F,FN); Reset (F,1); C := 0;
  200.   repeat
  201.     GET_ARC_ENTRY;
  202.     if not QUIT then
  203.       begin
  204.         Inc (WPX); New(SW[WPX]);       { store filename info in dynamic array }
  205.         with SW[WPX]^ do
  206.           begin
  207.             FSplit (SNAME,DIR,FNAME,EXT); F := FNAME; E := Copy(EXT+'    ',1,4)
  208.             SIZE := ARC1.UCompSize; RTYPE := 4;                   { comp file }
  209.             D_T := WLV; ANUM := ADX; VNUM := VDX;
  210.             ADD_CNAME;
  211.           end;
  212.         Inc (CCT); SSL; Inc (ARCS[ADX]^.COUNT)
  213.       end;
  214.     Inc (C,FSize+SizeOf(ARCHead))
  215.   until QUIT;
  216.   Close (F);
  217. end;  { DO_ARC }
  218.  
  219. (************************* LZH Files Processing ******************************)
  220. Type LZHHead = record
  221.                  HSize       : Byte;
  222.                  Fill1       : Byte;
  223.                  Method      : array[1..5] of char;
  224.                  CompSize    : LongInt;
  225.                  UCompSize   : LongInt;
  226.                  DOS_DT      : LongInt;
  227.                  Fill2       : Word;
  228.                  FileNameLen : Byte;
  229.                  FileName    : array[1..12] of char;
  230.                end;
  231.  
  232. Var LZH1     : LZHHead;
  233.  
  234. procedure GET_LZH_ENTRY;
  235. begin
  236.   FillChar(LZH1,SizeOf(LZHHead),#0); FillChar (DT,SizeOf(DT),#0);
  237.   L := SizeOf(LZHHead);
  238.   Seek (F,C); BlockRead (F,BUFF,L,RES);
  239.   Move (BUFF[1],LZH1,L);
  240.   with LZH1 do
  241.     if HSize > 0 then
  242.       begin
  243.         Move (FileNameLen,SNAME,FileNameLen+1);
  244.         UnPackTime (DOS_DT,DT);
  245.         FSize := CompSize;
  246.       end
  247.     else QUIT := true
  248. end;  { GET_LZH_ENTRY }
  249.  
  250. procedure DO_LZH (FN : string);
  251. begin
  252.   Assign (F,FN); Reset (F,1);
  253.   FSize := FileSize(F); C := 0; QUIT := false;
  254.   repeat
  255.     GET_LZH_ENTRY;
  256.     if not QUIT then
  257.       begin
  258.         Inc (WPX); New(SW[WPX]);       { store filename info in dynamic array }
  259.         with SW[WPX]^ do
  260.           begin
  261.             FSplit (SNAME,DIR,FNAME,EXT); F := FNAME; E := Copy(EXT+'    ',1,4)
  262.             SIZE := LZH1.UCompSize;
  263.             RTYPE := 4; ANUM := ADX; VNUM := VDX; D_T := LZH1.DOS_DT;
  264.             ADD_CNAME;
  265.           end;
  266.         Inc (CCT); SSL; Inc (ARCS[ADX]^.COUNT)
  267.       end;
  268.     Inc (C,FSize+LZH1.HSize+2)
  269.   until QUIT;
  270.   Close (F);
  271. end;  { DO_LZH }
  272.  
  273. (************************* ZOO Files Processing ******************************)
  274.  
  275. Type ZOOHead = record
  276.                  ZOOMark  : array[1..4] of char;
  277.                  ZOOType  : char;
  278.                  ZOOPack  : char;
  279.                  ZOONext  : LongInt;
  280.                  ZOOOff   : LongInt;
  281.                  DOS_DT   : LongInt;
  282.                  ZOOCRC   : Word;
  283.                  UCSize   : LongInt;
  284.                  CompSize : LongInt;
  285.                  Fill     : array[1..10] of char;
  286.                  ZOOName  : array[1..13] of char;
  287.                end;
  288. Type ZOOHT   = record
  289.                  Fill1    : array[1..20] of char;
  290.                  ZOOMark  : array[1..4] of char;
  291.                  ZOOStart : LongInt;
  292.                  ZOOChk   : LongInt;
  293.                  Fill2    : Word;
  294.                end;
  295.  
  296. Var ZOO1     : ZOOHead;
  297.     ZOOX     : ZOOHT;
  298.  
  299. procedure GET_ZOO_ENTRY;
  300. begin
  301.   FillChar(ZOO1,SizeOf(ZOOHead),#0); FillChar (DT,SizeOf(DT),#0);
  302.   L := SizeOf(ZOOHead); Seek (F,C); BlockRead (F,BUFF,L,RES);
  303.   Move (BUFF[1],ZOO1,L);
  304.   with ZOO1 do
  305.     if ZOONext > 0 then
  306.       begin
  307.         Move (ZOOName,SNAME[1],13); SNAME[0] := #0; I := 1;
  308.         while SNAME[I] > #0 do
  309.           begin
  310.             Inc(I); Inc (SNAME[0]);
  311.